home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / decorate.pm < prev    next >
Encoding:
Text File  |  2000-05-01  |  39.5 KB  |  1,176 lines
  1. use strict;
  2. use diagnostics;
  3. package Decorate;
  4. use Fcntl;
  5. use IO::File;
  6. use adynware::web_site;
  7. use adynware::utility;
  8. use adynware::utility_file;
  9. use adynware::unique_scripts;
  10.  
  11.  
  12.  
  13.  
  14. my $__color = "red";
  15. sub setColor { ($__color) = @_; }
  16.  
  17. my $__documentIDGenerator = 1;
  18.  
  19. my $__enabled = 1;
  20. sub setEnabled { ($__enabled) = @_; }
  21.  
  22. my $__expression = "<FONT color=$__color><B><SUP>%d</SUP></B></FONT>";
  23. sub setDefaultSuperscriptExpression { $__expression = "<FONT color=$__color><B><SUP>%d</SUP></B></FONT>"; }
  24. sub setSuperscriptExpression { ($__expression) = @_; }
  25. setDefaultSuperscriptExpression();
  26.  
  27.  
  28. my $__listFormsFirst = 0;
  29. sub listFormsFirst { $__listFormsFirst = 1; }
  30.  
  31. my $decorate__enabledJavaScriptHeader = "";
  32. my $__unique = 0;
  33. sub setUnique { ($__unique) = @_;}
  34.  
  35. my $__version = "";
  36. sub setVersion { ($__version) = @_; }
  37.  
  38.  
  39.  
  40.  
  41. my $WINDOW_GOTO   = "wk_window_goto(null,";
  42. my $WINDOW_CREATE = "wk_window_goto(";
  43.  
  44. my $decorate__disabledJavaScriptHeader =<<'EOS';
  45. <script language="JavaScript">
  46.  
  47. var c_char_w = 119;
  48. var wk_chained_key_handler = null;
  49.  
  50. function wk_key_handler(e) 
  51. {
  52.         if (e.target.type) return true;
  53.         else if (e.which==c_char_w)
  54.         {
  55.                 if (confirm("Enable Web Keyboard processing?")) 
  56.                 {
  57.                         window.open("http://__adynware__/perl/" + escape('Decorate::setEnabled(1)'), "tmp", "width=1,height=1");
  58.                         setTimeout("location.reload(true)", 500);
  59.                 } 
  60.                 return false;
  61.         }
  62.         if (wk_chained_key_handler) return wk_chained_key_handler();
  63.         return true;
  64. } 
  65. function wk_frame_onLoad()
  66. {
  67.         if (document.onKeyPress != wk_key_handler)
  68.         {
  69.                 wk_chained_key_handler = document.onKeyPress;
  70.                 document.onKeyPress = wk_key_handler;
  71.         } 
  72. }
  73. document.captureEvents(Event.KEYPRESS);
  74. document.onKeyPress = wk_key_handler;
  75. EOS
  76.  
  77. $decorate__enabledJavaScriptHeader =<<'EOS';
  78. <script language="JavaScript">
  79. var WINDOW_GOTO;
  80. var WINDOW_CREATE;
  81. var wk_action = new Array();
  82. var wk_chained_key_handler = null;
  83. var wk_chained_onerror = null;
  84. var wk_data = new Array();
  85. var wk_documentID;
  86. var wk_index = 0;
  87. var wk_itemCount = 0;
  88. var wk_loadComplete = false;
  89. var wk_minimumIndex = 0;
  90.  
  91. var c_control_e = 5;
  92. var c_control_j = 10;
  93. var c_control_k = 11;
  94. var c_control_l = 12;
  95. var c_control_t = 20;
  96. var c_control_y = 25;
  97.  
  98. var c_char_c = 99;
  99. var c_char_n = 110;
  100. var c_char_w = 119;
  101. var c_char_0 = 48;
  102. var c_char_9 = 57;
  103.  
  104. function wk_key_handler(e) 
  105. {
  106.         //defaultStatus = "got " + e.which; return true;
  107.         if (e.which==c_control_j)
  108.         {
  109.                 wk_frame_goto_next_interesting_leaf(1);
  110.                 return false;
  111.         }
  112.         if (e.which==c_control_l)
  113.         {
  114.                 wk_frame_goto_next_interesting_leaf(-1);
  115.                 return false;
  116.         }
  117.                                     
  118.         if (e.target.type) 
  119.         {
  120.                 if (e.which==c_control_e)
  121.                 {
  122.                         e.target.blur();
  123.                         window.defaultStatus = "Enter jump index:";
  124.                         return false;
  125.                 }
  126.                 return true;
  127.         }
  128.         if (c_char_0 <= e.which && e.which <= c_char_9)
  129.         {
  130.                 if (wk_index==0 && e.which==c_char_0)
  131.                 {
  132.                         window.defaultStatus = wk_data[0];
  133.                 }
  134.                 wk_index = (wk_index * 10) + e.which - c_char_0;
  135.                 var w = wk_find_item(wk_index);
  136.                 if (w) 
  137.                 {
  138.                         w.focus();
  139.                 }
  140.                 else
  141.                 {
  142.                         wk_index = e.which - c_char_0;
  143.                         w = wk_find_item(wk_index);
  144.                         if (w) 
  145.                         {
  146.                                 w.focus();
  147.                         }
  148.                         else w = window;
  149.                 }
  150.                 w.wk_index = wk_index;
  151.                 wk_link_show(w, wk_index);
  152.                 return false;
  153.         }
  154.         else if (e.which==c_char_c && 0 < wk_index && wk_index < wk_data.length)
  155.         {
  156.                 window.open("http://__adynware__/setClipboard/" + escape(wk_data[wk_index]), "tmp", "width=1,height=1");
  157.         }
  158.         else if (e.which==c_char_n && 0 < wk_index && wk_index < wk_data.length)
  159.         {
  160.                 if (wk_action[wk_index].indexOf(WINDOW_CREATE) >= 0)
  161.                 {
  162.                         window.open(wk_data[wk_index]);
  163.                 }
  164.                 else
  165.                 {
  166.                         defaultStatus = wk_data[wk_index] + " is not a window";
  167.                 }
  168.         }
  169.         else if (e.which==c_char_w)
  170.         {
  171.                 if (confirm("Disable Web Keyboard until you enter 'w' in the background?")) 
  172.                 {
  173.                         window.open("http://__adynware__/perl/" + escape('Decorate::setEnabled(0)'), "tmp", "width=1,height=1");
  174.                         setTimeout("location.reload(true)", 500);
  175.                 } 
  176.                 return false;
  177.         }
  178.         else 
  179.         {
  180.                 var tmpIndex = wk_index;
  181.                 wk_index = 0;
  182.                 if (e.which==13)
  183.                 {
  184.                         wk_link_goto(tmpIndex);
  185.                         return false;
  186.                 }
  187.         }
  188.         var notHandled = true;
  189.         if (wk_chained_key_handler)
  190.         {
  191.                 notHandled = wk_chained_key_handler();
  192.         }
  193.         if (notHandled) defaultStatus = "";
  194.         return notHandled;
  195. }
  196. function wk_get_field(originalFormIndex, originalFieldIndex, fieldName)
  197. {
  198.         var fieldIndex = originalFieldIndex;
  199.         for (var formIndex = originalFormIndex; formIndex < document.forms.length; formIndex++)
  200.         {
  201.                 var elements = document.forms[formIndex].elements;
  202.                 while (fieldIndex < elements.length)
  203.                 {
  204.                         //alert('Examining form ' + formIndex + ': field ' + fieldIndex + ': ' + elements[fieldIndex].name);
  205.                         if (elements[fieldIndex].name==fieldName) return elements[fieldIndex];
  206.                         fieldIndex++;
  207.                 }
  208.                 fieldIndex = 0;
  209.         }
  210.         alert("Web Keyboard: could not find field " + fieldName + " in form " + originalFormIndex);
  211.         return document.forms[originalFormIndex].elements[originalFieldIndex];
  212. } 
  213. function wk_get_link(href)
  214. {
  215.         for (var j=0; j < document.links.length; j++)
  216.         {
  217.                 if (document.links[j].href==href) return document.links[j];
  218.         }
  219.         alert("Web Keyboard: could not find a link with href " + href);
  220.         return null;
  221. } 
  222. function wk_find_item(n)
  223. {
  224.         if (n < wk_data.length && wk_data[n]) return self;
  225.         
  226.         var maxScript = wk_data.length - 1;
  227.         var w = wk_frame_get_next_leaf(self, 1);
  228.         for (var j = 0; w!=self && j < 20; j++)
  229.         {
  230.                 if (w.wk_data)
  231.                 {
  232.                         if ((n < w.wk_data.length) && w.wk_data[n]) return w;
  233.                 
  234.                         if (maxScript < w.wk_data.length - 1) maxScript = w.wk_data.length - 1;
  235.                 }
  236.                 w = wk_frame_get_next_leaf(w, 1);
  237.         }
  238.         if (n > maxScript) 
  239.         {
  240.                 return null;
  241.         } 
  242.         return self;
  243. }
  244. function wk_click_first_checkbox(box)
  245. {
  246.         if (eval(box + "[1]!=null"))
  247.         {
  248.                 eval(box + "[0].click()");
  249.         }
  250.         else
  251.         {
  252.                 eval(box + ".click()");
  253.         }
  254. }
  255.     
  256. function wk_link_goto(index) 
  257. {
  258.         if (index==0)
  259.         {
  260.                 defaultStatus = "no jump index specified";
  261.         }
  262.         else if (0 < index && index < wk_data.length && wk_data[index])
  263.         {
  264.                 if (wk_action[index] && wk_action[index]!="JavaScript")
  265.                 {
  266.                         var xx = "";
  267.                         var s = wk_action[index] +  "wk_data[" + index + "])";
  268.                         //alert('evaluation 1:'  + s);
  269.                         eval(s);
  270.                         //alert('evaluation 2:'  + xx);
  271.                         eval(xx);
  272.                 }
  273.                 else
  274.                 {
  275.                         //alert(' evaluating ' + wk_data[index]);
  276.                         eval(wk_data[index]);
  277.                 }
  278.         }
  279. }
  280.  
  281. function wk_link_show(w,index)
  282. {
  283.         if (!w.wk_data) return;
  284.         
  285.         var s = "";
  286.         if (0 > index || index >= w.wk_data.length) return;
  287.         else if (0==index) s = w.wk_data[0];
  288.         else 
  289.         {    
  290.                 s += index + ": ";
  291.                 if (w.wk_action[index] && ((w.wk_action[index].indexOf(WINDOW_GOTO) >= 0) || (w.wk_action[index].indexOf(WINDOW_CREATE) >= 0) || (w.wk_action[index] == "JavaScript")))
  292.                 {
  293.                         s += w.wk_data[index];
  294.                 }
  295.                 else if (w.wk_data[index] != null)
  296.                 {
  297.                         s += "form field";
  298.                 }
  299.                 else
  300.                 {
  301.                         s += "-";
  302.                 }
  303.         }
  304.         w.defaultStatus = defaultStatus = s;
  305. }
  306.  
  307. function wk_frame_dive(w, direction)
  308. {
  309.         while (w.frames.length > 0)
  310.         {
  311.                 if (direction==-1)
  312.                 {
  313.                         w=w.frames[0];
  314.                 }
  315.                 else
  316.                 {
  317.                         w=w.frames[w.frames.length -1];
  318.                 }
  319.         }
  320.         return w;
  321. }
  322.  
  323. function wk_get_frame_name(w)
  324. {
  325.         if(w==w.top) return "window.top";
  326.         var parent = w.parent;
  327.         for (var j = 0; j < parent.frames.length; j++)
  328.         {
  329.                 if(parent.frames[j]==w) return wk_get_frame_name(parent) + ".frames[" + j + "]";
  330.         }
  331.         alert(' wk_get_frame_name could not resolve a frame');
  332.         return "";
  333. }
  334.  
  335. var wk_flashing = false;
  336. var wk_preventFlash = 0;
  337. function wk_flash(w)
  338. {
  339.         if (wk_preventFlash > 0)
  340.         {
  341.                 wk_preventFlash--;
  342.                 return;
  343.         }
  344.         if (wk_flashing || (w==window.top)) return;
  345.         wk_flashing = true;
  346.                         
  347.         var x = wk_get_frame_name(w) + ".document.bgColor = '" + w.document.bgColor + "'; wk_flashing = false";
  348.         w.setTimeout(x, 300);
  349.         if(w.document.bgColor=="#808080") w.document.bgColor = "black";
  350.         else                              w.document.bgColor = "gray";
  351. }
  352.  
  353. function wk_frame_get_index(w)
  354. {
  355.         if ((w.self==window.top) || (w.parent.frames.length==1))
  356.         {
  357.                 return 0;
  358.         }
  359.         var j;
  360.         for (j = 0; j < w.parent.frames.length; j++)
  361.         {
  362.                 if (w.parent.frames[j]==w)
  363.                 {
  364.                         return j;
  365.                 }
  366.         }
  367.         alert("could not find current window in w.parent.frames");
  368.         return 0;
  369. }
  370.  
  371. function wk_frame_get_sibling(w, increment)
  372. {
  373.         if (w==window.top)
  374.         {
  375.                 return null;
  376.         }
  377.         var index = wk_frame_get_index(w);
  378.         index += increment;
  379.         if ((index < 0) || (index >= w.parent.frames.length))
  380.         {
  381.                 return null;
  382.         }
  383.         return w.parent.frames[index];
  384. }
  385.  
  386. function wk_frame_get_next_leaf(w, increment)
  387. {
  388.         while (w!=window.top)
  389.         {
  390.             var sibling = wk_frame_get_sibling(w, increment);
  391.             if(!sibling) w = w.parent;
  392.             else
  393.             {
  394.                 w = sibling;
  395.                 break;
  396.             } 
  397.         }
  398.         return wk_frame_dive(w, -increment);
  399. }
  400. function wk_frame_goto_next_interesting_leaf(increment)
  401. {
  402.         var firstNeighbor = wk_frame_get_next_leaf(self, increment);
  403.         var w = firstNeighbor;
  404.         var next = w;
  405.         for (var j = 0; !w.wk_itemCount && j < 20; j++)
  406.         {
  407.                 w = wk_frame_get_next_leaf(w, increment);
  408.                                                                                 
  409.                 if (w==firstNeighbor || w==self) 
  410.                 {
  411.                         next = firstNeighbor;
  412.                         break;
  413.                 } 
  414.                 next = w;
  415.         }
  416.         next.focus();
  417.         next.wk_index = 0;
  418.         wk_flash(next);
  419. }
  420. function wk_window_find(name, w)
  421. {
  422.         if (!w) return null;
  423.         if (w.name==name) return w;
  424.         for (var j = 0; j<w.frames.length; j++)
  425.         {
  426.                 var hit = wk_window_find(name, w.frames[j]);
  427.                 if (hit) return hit;
  428.         }
  429.         return null;
  430. }
  431. function wk_window_goto(windowName, link)
  432. {
  433.         var targetWindow;
  434.         if (windowName) targetWindow = wk_window_find(windowName, self.top);
  435.         else            targetWindow = self;
  436.                                
  437.         //alert("window goto(" + windowName + "," + link + "):" + targetWindow);
  438.         //if (targetWindow)
  439.         //{
  440.         //alert("targetWindow.top.wk_documentID=" + targetWindow.top.wk_documentID + "\ntargetWindow.wk_documentID=" + targetWindow.wk_documentID);
  441.         //}
  442.                 
  443.         if (targetWindow
  444.         && targetWindow.top.wk_documentID
  445.         && targetWindow.wk_documentID
  446.         && link.charAt(0) != '#'
  447.         && link.indexOf("javascript:") == -1
  448.         && (targetWindow.top.wk_documentID != targetWindow.wk_documentID))
  449.         {
  450.                 var s = "$redirectTarget='" + link + "';unique_scripts::replaceFrame(" + targetWindow.top.wk_documentID + "," + targetWindow.wk_documentID + ", '" + link  + "');";
  451.                 s = "http://__adynware__/perl/" + escape(s);
  452.                 if (windowName)
  453.                 {
  454.                         open(s, windowName);
  455.                 }
  456.                 else
  457.                 {
  458.                         location = s;        
  459.                 }
  460.         }
  461.         else
  462.         {
  463.                 if (windowName)
  464.                 {
  465.                         open(link, windowName);        
  466.                 }
  467.                 else
  468.                 {
  469.                         window.location = link;        
  470.                 } 
  471.         } 
  472. }
  473. function wk_frame_onLoad()
  474. {
  475.         if (onerror != wk_onerror)
  476.         {
  477.                 wk_chained_onerror = onerror;
  478.                 onerror = wk_onerror;
  479.         } 
  480.         if (document.onKeyPress != wk_key_handler)
  481.         {
  482.                 wk_chained_key_handler = document.onKeyPress;
  483.                 document.onKeyPress = wk_key_handler;
  484.         }
  485.         wk_loadComplete = true;
  486. }
  487. function wk_onerror(message, URL, line)
  488. {
  489.         if (message.indexOf("access disallowed from scripts")==-1) 
  490.         {
  491.                 if (wk_chained_onerror) return wk_chained_onerror();
  492.                 return false;
  493.         }
  494.         setTimeout("defaultStatus = ''", 2000);
  495.         defaultStatus = "Web Keyboard: JavaScript prevents frames from different domains from communicating";
  496.         return true;
  497. } 
  498.  
  499. document.captureEvents(Event.KEYPRESS);
  500. document.onKeyPress = wk_key_handler;
  501. onerror = wk_onerror;
  502. EOS
  503.  
  504. $decorate__enabledJavaScriptHeader .= "\nWINDOW_GOTO = '$WINDOW_GOTO';\nWINDOW_CREATE = '$WINDOW_CREATE';\n";
  505.  
  506.  
  507. sub SuperScript
  508. {
  509.         my($self, $isLink, $data, $action) = @_;
  510.         $self->{"itemCount"}++;
  511.                         
  512.         my $index;
  513.         if (defined $self->{"unique"})
  514.         {
  515.                 my $x = $self->{"unique"};
  516.                 my $documentID = $self->{"documentID"};
  517.                 $index = $$x->getIndex($documentID, $isLink);
  518.                 $self->{"index"} = $index + 1;     # disaster insurance: keep in sync
  519.         }
  520.         elsif ($isLink or !defined $self->{"formFieldIndex"} or (25 < $self->{"formFieldIndex"}))
  521.         {
  522.                 $index = $self->{"index"}++;
  523.         }
  524.         else
  525.         {
  526.                 $index = $self->{"formFieldIndex"}++;
  527.         }
  528.                 
  529.         if (!defined $self->{"firstItemDone"})
  530.         {
  531.                 $self->{"firstItemDone"} = 1;
  532.                 $self->{"pendingJavaScript"} .= "wk_minimumIndex=$index;\n";
  533.         } 
  534.  
  535.         $data =~ s/\000//g; # remove garbage which HTML allows but JavaScript doesn't
  536.         if (!$isLink)
  537.         {
  538.                 $data = "'$data'";
  539.                 $action = "\"$action\"" if defined $action;
  540.         }
  541.         $self->{"pendingJavaScript"} .= "wk_data[$index]=" . $data . ";\n";
  542.         if (defined $action)
  543.         {
  544.                 $self->{"pendingJavaScript"} .= "wk_action" . "[$index]=$action;\n";
  545.         }
  546.         #print "decorate::Super script $index: $data\n";
  547.         return sprintf $__expression, $index;
  548. }
  549.  
  550. sub Init
  551. {
  552.         my($self, $target, $status) = @_;
  553.         if (defined $target)
  554.         {
  555.                 $self->{"base"} = utility_file::dirname($target) . "/";
  556.         }
  557.         else
  558.         {
  559.                 $self->{"base"} = "";
  560.         }
  561.         utility::Log("decorate::Init($self, $target, $status)" . $self->{"base"});
  562.                         
  563.         $self->{"allJavaScript"} = "";
  564.         $self->{"documentID"} = $__documentIDGenerator++;    
  565.         $self->{"enabled"} = 1;
  566.         $self->{"fieldIndex"} = 0;    # place to keep track of form field index 
  567.         $self->{"formIndex"} = -1;    # place to keep track of form index 
  568.         $self->{"hasScriptContent"} = 0;    # is there JavaScript code in the document already?
  569.         $self->{"headerSeen"} = 0;
  570.                 
  571.         if ($__listFormsFirst)
  572.         {
  573.                 $self->{"index"} = 26;        # counter for generating superscripts for links
  574.                 $self->{"formFieldIndex"} = 1;    # counter for generating superscripts for form fields
  575.         }
  576.         else
  577.         {
  578.                 $self->{"index"} = 1;        # counter for generating superscripts for all items, unless unique
  579.         }
  580.         
  581.         $self->{"inputGroupIndices"} = {};    # place to keep track of radio button indices
  582.         $self->{"inForm"} = 0;        # are we in a form?
  583.         $self->{"inScript"} = 0;    # are we within a <script...</script> block?  If yes, then be careful.
  584.         $self->{"inComment"} = 0;    # are we within a <--...!-> HTML comment block?  If yes, then ignore fields.
  585.         $self->{"itemCount"} = 0;
  586.         $self->{"pendingJavaScript"} = "wk_documentID = " . $self->{"documentID"} . ";\n";
  587.         $self->{"nameGenerationIndex"} = 0;
  588.         $self->{"safe"} = 1;        # is it safe to insert JavaScript?
  589.         $self->{"slicedItem"} = "";    # holding area for link fragment which crosses the chunk boundary
  590.         $self->{"status"} = "Processing...";
  591.         $self->{"target"} = $target;
  592.         $self->{"unique"} = unique_scripts::findFrameGroup($target, ($status!=302));
  593.         return "";
  594. }                
  595.  
  596. sub Cleanup
  597. {
  598.         my($self) = @_;
  599.         my $string = $self->{"slicedItem"};
  600.         
  601.         return $string unless $self->{"enabled"} and $self->{"headerSeen"};
  602.         
  603.         return "$string\n<script language=\"JavaScript\">\nwk_frame_onLoad();\n</script>\n" unless $__enabled;
  604.                 
  605.                                 
  606.         $self->{"status"} = "Done";
  607.         
  608.         $string .= $self->GetPendingJavaScript(1, "wk_frame_onLoad();", 1);
  609.         
  610.         return $string;
  611. }
  612.  
  613. sub DoLink
  614. {
  615.         my($self, $link) = @_;
  616.         my $linkDestination;
  617.         if ($link =~ m{\bhref\s*=\s*("\s*[^"]+\s*")}i)
  618.         {
  619.                 $linkDestination = $1;
  620.         }
  621.         elsif ($link =~ m{\bhref\s*=\s*('\s*[^']+\S\s*')}i)
  622.         {
  623.                 $linkDestination = $1;
  624.         }
  625.         elsif ($link =~ m{\bhref\s*=\s*([^'"\s>]+)}i)
  626.         {
  627.                 $linkDestination = qq("$1");
  628.         }
  629.         else
  630.         {
  631.                 return ""; # anchor
  632.         }
  633.                         
  634.         my $JavaScript = undef;
  635.         if ($link =~ m{\bonclick\s*=\s*("\s*[^"]+\s*")}i)
  636.         {
  637.                 $JavaScript = $1;
  638.         }
  639.         if ($link =~ m{\bonclick\s*=\s*('\s*[^']+\s*')}i)
  640.         {
  641.                 $JavaScript = $1;
  642.         }
  643.         if (!defined $JavaScript)
  644.         {
  645.                 $JavaScript = "";
  646.         }
  647.         else
  648.         {
  649.                 my $cookedLinkDestination = $linkDestination;
  650.                 #$cookedLinkDestination =~ s/(['"])/\\$1/g;
  651.                 $JavaScript =~ s/\n/ /g;
  652.                 $JavaScript =~ s/return\s+true\s*(['"])\s*$/$1/;
  653.                 $JavaScript =~ s/this/wk_get_link($cookedLinkDestination)/g;
  654.                 $JavaScript =~ s/(['"])/\\$1/g;
  655.                 $JavaScript = "'xx=' + \"$JavaScript\" + ';' + ";
  656.         }
  657.                                 
  658.         return "" if $link =~ /\bismap\b/i;         # no support for image maps
  659.                                                 
  660.         $linkDestination =~ s/[\015\n]//g;         # remove ^Ms
  661.                                                 
  662.         $linkDestination =~ s/\bjavascript:/javascript:/i; # assures lowercase
  663.                 
  664.         my $mark = "";
  665.         if ($linkDestination =~ s/^(['"])(.*)['"]$/$2/)
  666.         {
  667.                 # removed trailing and leading quotes
  668.                 $mark = $1;
  669.         }
  670.                                                                                                 
  671.         $linkDestination = $mark . web_site::makeAbsolute($linkDestination, $self->{"base"}, $self->{"target"}) . $mark;
  672.                                                                         
  673.         my $action;
  674.         my $target = "";
  675.         if ($link =~ m{\btarget\s*=\s*['"]?(\w+)}i )
  676.         {
  677.                 $target = $1;
  678.         }
  679.         elsif (defined $self->{"window_target"})
  680.         {
  681.                 $target = $self->{"window_target"};
  682.         }
  683.                                         
  684.         if ($target)
  685.         {
  686.                 $action = $WINDOW_CREATE . "'$target', ";
  687.         }
  688.         else
  689.         {
  690.                 $action = $WINDOW_GOTO;
  691.         }
  692.         $action = "\"$action\""; 
  693.         return $self->SuperScript(1, $linkDestination, $JavaScript . $action);
  694. }
  695.  
  696. sub ProcessBaseStatements
  697. {
  698.         my($self, $string) = @_;
  699.         my $baseStatements = "";
  700.                 
  701.         # capture trailing comment limit in the following regexp, so we can tell what base statements were really commented out
  702.         while ($string =~ /<base\b(.*?>)\s*(-->)?/gis)
  703.         {
  704.                 $baseStatements .= $1 unless $2;
  705.         }
  706.         if ($baseStatements)
  707.         {
  708.                 my $statement = $baseStatements;
  709.                                                                                                         
  710.                 if ($statement =~ s{.*\bhref\s*=\s*}{}i)
  711.                 {
  712.                         if ($statement =~ m{^'([^']*?)'}gi
  713.                         or  $statement =~ m{^"([^"]*?)"}gi
  714.                         or  $statement =~ m{^([^\s'">]+)}gi)
  715.                         {
  716.                                 my $base = $self->{"base"};
  717.                                 if (!$base)
  718.                                 {
  719.                                         $base = $1;
  720.                                 }
  721.                                 else
  722.                                 {
  723.                                         $base = web_site::makeAbsolute($1, $base, undef);
  724.                                 }   
  725.                                 $self->{"base"} = utility_file::dirname($base) . "/";
  726.                         }
  727.                         $statement = $baseStatements;
  728.                 }
  729.                 if ($statement =~ s{.*\btarget\s*=\s*}{}i)
  730.                 {
  731.                         if ($statement =~ m{^'([^']*?)'}gi
  732.                         or  $statement =~ m{^"([^"]*?)"}gi
  733.                         or  $statement =~ m{^([^\s'">]+)}gi)
  734.                         {
  735.                                 $self->{"window_target"} = $1;
  736.                         }
  737.                 }
  738.         }
  739. }
  740.  
  741.  
  742. sub DoLinks
  743. {
  744.         my($self, $string) = @_;
  745.                         
  746.         # ignore links with no associated text (e.g., <a  href="http://alpha.cmpexpress.com/store/htmlos/27127" ></a>)
  747.         $string =~ s
  748.         {
  749.                 <\s*a\b([^>]*>\s*)<\s*/\s*a\s*>
  750.         }{"<_a" . $1 . "</_a>"}egisx;
  751.                                 
  752.         $string =~ s
  753.         {
  754.                 <\s*a\b([^<]*?)<\s*/\s*a\s*>
  755.         }{"<_a" . $1 . "</_a>" . $self->DoLink($1)}egisx;
  756.                                 
  757.         # process links which are terminated with /a, but have nested HTML declarations
  758.         $string =~ s
  759.         {
  760.                 <\s*a\b(.*?)<\s*/a\s*>
  761.         }{"<_a" . $1 . "</_a>" . $self->DoLink($1)}egisx;
  762.         
  763.         # process links which are terminated with /td
  764.         $string =~ s
  765.         {
  766.                 <\s*a\b(.*?)<\s*/td\s*>
  767.         }{"<_a" . $1 . $self->DoLink($1) . "</td>"}egisx;
  768.                                                                                  
  769.         # process links which are not terminated with /a, or which have nested font directives
  770.         #$string =~ s
  771.         #{
  772.         #<\s*a\b(.*?)<(.*?)>
  773.         #}{"<_a" . $1 . "</_a>" . $self->DoLink($1) . "<$2>"}egisx;
  774.                                                                                  
  775.                                
  776.         if ($string =~ s/(<\s*a\b.*$)//is)
  777.         {
  778.                 my $addition = $1;
  779.                 if ($addition =~ m{</?_a})
  780.                 {
  781.                         utility::Log("confused by malformed HTML: mismatched <a> and </a> seen");
  782.                         $string .= $addition;    # put it back
  783.                 }
  784.                 else
  785.                 {
  786.                         if ($self->{"slicedItem"})
  787.                         {
  788.                                 utility::Log("a: already: slice:" . $self->{"slicedItem"});
  789.                                 $self->{"slicedItem"} = $addition . $self->{"slicedItem"};
  790.                         }
  791.                         else
  792.                         {
  793.                                 $self->{"slicedItem"} = $addition;
  794.                         }
  795.                 }
  796.         }
  797.                                                                         
  798.         $string =~ s/<_a/<a/g;
  799.         $string =~ s{</_a}{</a}g;
  800.         return $string;
  801. }                                
  802.         
  803. sub Chunk
  804. {
  805.         my($self, $stringR) = @_;
  806.                                                
  807.         if ($self->{"slicedItem"})
  808.         {
  809.                 utility::Log("chunk: slice:" . $self->{"slicedItem"});
  810.                 $$stringR = $self->{"slicedItem"} . $$stringR;
  811.                 $self->{"slicedItem"} = "";
  812.         }
  813.         if ($$stringR =~ s/(<[^<>]*$)//is) # grab sliced tag from the end
  814.         {
  815.                 $self->{"slicedItem"} = $1;
  816.         }
  817.                                 
  818.         #$$stringR =~ s/(<script[^>]*>)\s*<!--[^\n]*/$1 /gis; 
  819.         #$$stringR =~ s{-->\s*(</script)}{ $1}gis; 
  820.         #$$stringR =~ s/<!--.*?-->//gs; 
  821.                                                                         
  822.         $self->ProcessBaseStatements($$stringR);
  823.                                                         
  824.         my $headerPreviouslyInserted = $self->{"headerSeen"};
  825.         if (!$headerPreviouslyInserted)
  826.         {
  827.                 if ($$stringR =~ /wk_key_handler/)
  828.                 {
  829.                         utility::Log($self->{"target"} . " contents already processed by Web Keyboard");
  830.                         $self->{"enabled"} = 0; 
  831.                 }
  832.                 elsif ($$stringR !~ /^\s*</s and $$stringR !~ /^\s*$/s)
  833.                 {
  834.                         utility::Log($self->{"target"} . " contents do not look like HTML.  Web Keyboard will not process this file");
  835.                         $self->{"enabled"} = 0; 
  836.                 }
  837.                 else
  838.                 {
  839.                         my $header = $__enabled ? $decorate__enabledJavaScriptHeader : $decorate__disabledJavaScriptHeader;
  840.                                                 
  841.                         $header .= $self->{"pendingJavaScript"} . "\n";
  842.                         $self->{"pendingJavaScript"} = "";
  843.                                                 
  844.                         $header .= "</script>\n";
  845.                         if ($$stringR !~ s{<HEAD>}{<HEAD>$header}i)
  846.                         {
  847.                                 $$stringR = $header . $$stringR;
  848.                         }
  849.                         $self->{"headerSeen"} = 1;
  850.                 }
  851.         }
  852.         return unless $__enabled and $self->{"enabled"};
  853.         if ($$stringR =~ m{\bdocument\.write}i)
  854.         {
  855.                 utility::Log("saw document.write calls");
  856.                                                                                                 
  857.                 $self->{"safe"} = 0;
  858.         }
  859.         my $inScript = $self->{"inScript"};
  860.         #utility::Log("Chunk processing entrance: in script: $inScript");
  861.                                                                                                                                         
  862.         if (!$self->{"hasScriptContent"} and $$stringR =~ m{<\s*script\b}i)
  863.         {
  864.                 $self->{"hasScriptContent"} = 1;
  865.                 $self->{"safe"} = 0;
  866.         }
  867.                                                                                         
  868.         my @processedChunks = ();
  869.         my $generationIndex = 0;
  870.         $$stringR =~ s{</script>(.*?)<script}{$processedChunks[$generationIndex] = $self->DoChunk($1, "/script to script"), "<s__" . $generationIndex++ . "__t>"}egis;
  871.                                                                                                         
  872.         if ($inScript)
  873.         {
  874.                 if ($$stringR =~ s{</script(.*)}{"</s____t" . $self->DoChunk($1, "in:/script on")}egis)
  875.                 {
  876.                         $self->{"inScript"} = 0;
  877.                 }
  878.         }
  879.         else
  880.         {
  881.                 if ($$stringR =~ s{^(.*?)<script}{$self->DoChunk($1, "out: to script") . "<s____t"}egis)
  882.                 {
  883.                         if ($$stringR =~ s{</script>(.*)}{"</s____t>" . $self->DoChunk($1, "out:/script on")}egis)
  884.                         {
  885.                                 $self->{"inScript"} = 0;
  886.                         }
  887.                         else
  888.                         {
  889.                                 $self->{"inScript"} = 1;
  890.                         }
  891.                 }
  892.                 else
  893.                 {
  894.                         $$stringR = $self->DoChunk($$stringR, "out: all");
  895.                 } 
  896.         }
  897.         $$stringR =~ s/\bs____t\b/script/g;
  898.         $$stringR =~ s{<s__(\d+)__t>}{"</script>" . $processedChunks[$1] . "<script"}eg;
  899.                                                         
  900.         $$stringR =~ s/<!doctype.*?>//i;  # some of the stricter doctypes reject my JavaScript
  901.                 
  902.         #utility::Log("Chunk processing exit: in script: " . $self->{"inScript"});
  903.         if ($headerPreviouslyInserted and $self->{"pendingJavaScript"})
  904.         {
  905.                 $$stringR = $self->AddJavaScript($$stringR);
  906.         }
  907. }
  908.  
  909. sub DoChunk
  910. {
  911.         my($self, $string, $from) = @_;
  912.         #print "DoChunk!!(" . (defined $self->{"unique"}) . ") $from: $string!!\n";
  913.                                                                 
  914.         if ($__unique)
  915.         {
  916.                 if (!defined $self->{"unique"} and $string =~ m/<\s*frameset/is)
  917.                 {
  918.                         $self->{"uniqueParent"} = unique_scripts::create($__listFormsFirst, $self->{"documentID"}, $self->{"target"});
  919.                 }
  920.                 if (defined $self->{"uniqueParent"})
  921.                 {
  922.                         $string =~ s/(<\s*frame\b.*?src\s*=\s*['"]?([^'"\s]+))/my $x=$self->{"uniqueParent"}; $$x->addFrame(web_site::makeAbsolute($2, $self->{"base"}, undef)), $1/egi;
  923.                 }
  924.         }
  925.                                         
  926.         if ($string =~ m{<\s*iframe}i)
  927.         {
  928.                 $self->{"safe"} = 0;
  929.         }
  930.                                                                                       
  931.                                                           
  932.         my @htmlComments = ();
  933.         my $generationIndex = 0;
  934.         if ($self->{"inComment"})
  935.         {
  936.                 if ($string =~ m/-->/)
  937.                 {
  938.                         $string =~ s{(^.*?-->)}{$htmlComments[$generationIndex] = $1, "<h__" . $generationIndex++ . "__c>"}egs;
  939.                         $self->{"inComment"} = 0;
  940.                 }
  941.         }
  942.                 
  943.         if (!$self->{"inComment"})
  944.         {
  945.                 $string =~ s{(<!--.*?-->)}{$htmlComments[$generationIndex] = $1, "<h__" . $generationIndex++ . "__c>"}egs;
  946.                 if ($string =~ m/<!--/)
  947.                 {
  948.                         $string =~ s{(<!--.*$)}{$htmlComments[$generationIndex] = $1, "<h__" . $generationIndex++ . "__c>"}egs;
  949.                         $self->{"inComment"} = 1;
  950.                 }
  951.                                                 
  952.                 my $formsDone = 0;
  953.                 if ($self->{"inForm"})
  954.                 {
  955.                         if ($string =~ s{(.*?)</form>}{$self->DecorateForm($1) . "</f__m>"}ise)
  956.                         {
  957.                                 $self->{"inForm"} = 0;
  958.                         }
  959.                         else
  960.                         {
  961.                                 $string = $self->DecorateForm($string);
  962.                                 $formsDone = 1;
  963.                         }
  964.                 }
  965.                 if (!$formsDone)
  966.                 {
  967.                         $string =~ s{<form\b(.*?)</form>}{"<f__m" . $self->DecorateForm($1) . "</f__m>"}gise;
  968.                         if ($string =~ s{<form\b(.*)}{"<f__m" . $self->DecorateForm($1)}ise)
  969.                         {
  970.                                 $self->{"inForm"} = 1;
  971.                         }
  972.                         else
  973.                         {
  974.                                 $self->{"inForm"} = 0;
  975.                         }
  976.                         
  977.                 }
  978.                 $string =~ s/\bf__m\b/form/gi;
  979.         }                        
  980.         $string =~ s{<h__(\d+)__c>}{$htmlComments[$1]}eg;
  981.         
  982.         $string = $self->DoLinks($string);
  983.         return $string;
  984. }
  985.                                                                                                                 
  986. sub GetPendingJavaScript
  987. {
  988.         my($self, $addScriptTags, $extra, $eof) = @_;
  989.         my $string = "";
  990.         $string .= "<script language=\"JavaScript\">\n" if $addScriptTags;
  991.         if ($eof or $self->{"pendingJavaScript"})
  992.         {
  993.                 $self->{"allJavaScript"} .= $self->{"pendingJavaScript"};
  994.                 if ($eof)
  995.                 {
  996.                         $string .= $self->{"allJavaScript"};
  997.                 }
  998.                 else
  999.                 {
  1000.                         $string .= $self->{"pendingJavaScript"};
  1001.                 } 
  1002.                 $self->{"pendingJavaScript"} = "";
  1003.         }
  1004.         $string .= "wk_data[0]=\"Web Keyboard $__version: " . $self->{"status"} . "\";\n";
  1005.         $string .= "wk_itemCount=" . $self->{"itemCount"} . ";\n";
  1006.         $string .= "$extra\n" if $extra;
  1007.         $string .= "</script>\n\n"  if $addScriptTags;
  1008.         return $string;
  1009. }
  1010.  
  1011. sub AddJavaScript
  1012. {
  1013.         my($self, $string) = @_;
  1014.         if ($self->{"hasScriptContent"})
  1015.         {
  1016.                 if (($string =~ s{</script>}{"</script>" . $self->GetPendingJavaScript(1, '', 0)}ei)
  1017.                 ||  ($string =~ s{<script\b}{$self->GetPendingJavaScript(1, '', 0) . "<script "}ei))
  1018.                 {
  1019.                         #print "$self: links cleared script\n";
  1020.                 }
  1021.         }
  1022.         elsif ($self->{"safe"})
  1023.         {
  1024.                 if ($string =~ s{</body>}{$self->GetPendingJavaScript(1, '', 0) . "</body>"}ei)
  1025.                 {
  1026.                         #print "$self: links cleared /html:$string\n";
  1027.                 }
  1028.                 elsif (($string =~ s{(</(a|select)>)}{"$1\n" . $self->GetPendingJavaScript(1, '', 0)}ei)
  1029.                 or  ($string =~ s{(<(a|input|select)\b)}{"\n" . $self->GetPendingJavaScript(1, '', 0)}ei)
  1030.                 )
  1031.                 {
  1032.                         #print "$self: links cleared select/input>\n";
  1033.                 }
  1034.         }
  1035.         return $string;
  1036. }
  1037.  
  1038.  
  1039. sub DecorateForm
  1040. {
  1041.         my($self, $form_text) = @_;
  1042.         utility::Log("---DecorateForm:$form_text");
  1043.         if (!$self->{"inForm"})
  1044.         {
  1045.                 # either we are processing the entire form, or this is the first chunk of this form
  1046.                 $self->{"fieldIndex"} = 0;
  1047.                 $self->{"formIndex"}++;
  1048.         }
  1049.                                         
  1050.         # next expression gives the correct behavior (for buttons with names like
  1051.         # ">> Next" but is too slow in some cases.
  1052.         #$form_text =~ s{(<\s*(input|select|textarea)\b([^'">]+|"[^"]*"|'[^']*')+>)}{$self->DecorateInputField($1)}egis;
  1053.         
  1054.         $form_text =~ s{(<\s*(input|select|textarea)\b[^>]+>)}{$self->DecorateInputField($1)}egis;
  1055.                         
  1056.         # DecorateInputField prepends a '<' to the finished text; thus input fields which lack
  1057.         # the extra '<' were not processed:
  1058.         if (!$self->{"slicedItem"} and $form_text =~ s/([^<])(<\s*[^>]*$)/$1/is)
  1059.         {
  1060.                 $self->{"slicedItem"} = $2;
  1061.                 utility::Log("post form: slice:" . $self->{"slicedItem"});
  1062.         }
  1063.         
  1064.         $form_text =~ s/<<\s*(input|select|textarea)/<$1/gi;
  1065.         return $form_text;
  1066. } 
  1067.         
  1068. sub DecorateInputField
  1069. {
  1070.         my($self, $input) = @_;
  1071.                 
  1072.         # mark this input field as processed, to prevent it from being copied into slicedItem
  1073.         $input = "<" .  $input;  
  1074.         
  1075.         my $type = '';
  1076.         if ($input =~ /\btype\s*=\s*['"]?(\w+)/i)
  1077.         {
  1078.                 $type = $1;
  1079.         }
  1080.         my $name = '';
  1081.         if ($input =~ /\bname\s*=\s*['"]?([-\w_\.]+)/i)
  1082.         {
  1083.                 $name = $1;
  1084.         }
  1085.         $name = "\"$name\"";
  1086.         
  1087.         my $fieldIndex = $self->{"fieldIndex"}++;
  1088.         
  1089.         print "DecorateInputField($name($fieldIndex, $type))\n";
  1090.         
  1091.         my $elements = "wk_get_field($self->{'formIndex'},";
  1092.         if ($type =~ /^button$/i)
  1093.         {
  1094.                 return $input . $self->SuperScript(0, $elements . "$fieldIndex, $name).onclick()");
  1095.         }
  1096.         elsif ($type =~ /^hidden$/i)
  1097.         {
  1098.                 return $input;
  1099.         }
  1100.         elsif ($type =~ /^image/i)
  1101.         {
  1102.                 # this doesn't work.  For the case where the form contains a
  1103.                 # single input image, and is POSTed, the post data should contain
  1104.                 # "&imageInput.x=7imageInput.x=32" but does not with this method.
  1105.                 # 'next 20' image button on some search results yields this behavior
  1106.                 #return $input . $self->SuperScript(0, "document.forms[$self->{'formIndex'}].submit()");
  1107.                 $self->{"fieldIndex"}--;
  1108.                 return $input;
  1109.         }
  1110.         elsif ($type =~ /^(checkbox|radio|reset|submit)$/i)
  1111.         {
  1112.                 return $input unless $name or $type !~ /^radio$/i; # anonymous radio button setting crashes navigator
  1113.                 return $input . $self->SuperScript(0, $elements . "$fieldIndex, $name).click()");
  1114.         }
  1115.         return $self->SuperScript(0, $elements . "$fieldIndex, $name).focus()") . $input;
  1116. }
  1117.  
  1118. sub Page
  1119. {
  1120.         my($data, $target) = @_;
  1121.  
  1122.         my $d = Decorate->new($target, 200);
  1123.         $d->Chunk(\$data);
  1124.         return $data . $d->Cleanup();
  1125. }
  1126.  
  1127. #=====================================================================================
  1128. # methods below
  1129. # 
  1130. use vars '@ISA';
  1131. require adynware::s_user;
  1132. @ISA = qw(s_user);
  1133.  
  1134. sub DocumentStart
  1135. {
  1136.         my($self) = @_;
  1137.         return "";
  1138. }
  1139.  
  1140. sub DocumentFinish
  1141. {
  1142.         my($self) = @_;
  1143.         return $self->Cleanup();
  1144. }
  1145.  
  1146. sub DocumentChunk
  1147. {
  1148.         my($self, $chunk) = @_;
  1149.         my $s = $self->Chunk($chunk);
  1150.         #print     "\n===================================================================\n";
  1151.         #print $s, "\n===================================================================\n";
  1152.         return $s;
  1153. }
  1154.  
  1155. sub Redirect
  1156. {
  1157.         my($self, $oldURL, $newURL) = @_;
  1158.         unique_scripts::redirect($oldURL, $newURL);
  1159. }
  1160.  
  1161. sub new
  1162. {
  1163.         my $this = shift;
  1164.         my $target = shift;
  1165.         my $status = shift;
  1166.         die "target is a required argument for decorate object" unless defined $target;
  1167.         my $class = ref($this) || $this;
  1168.         my $self = {};
  1169.         
  1170.         bless $self, $class;
  1171.         $self->Init($target, $status);
  1172.         return $self;
  1173. }
  1174.  
  1175. 1;
  1176.